%{
    open Printf
    module H = Hashtbl
    module L = List
   (*
    *  This needs to point to the local Maude 
    *)
   (* let maude = "maude.darwin"*) 
    let maude = "/home/software/maude22/maude.linux"
   (* name of JavaCFG *) 
    let java_cfg = "JavaCFG.maude"
   (* directory where algo.txt, clone_algo.txt, and JavaCFG.maude are*) 
    let work_dir = "/home/software/javamop/plugins/CFG"    
   (* side effects are bad, but threading a list through all the
    * productions would be worse
    *)
    let events = ref []
    let cfg = ref ""
    let t_counter = ref 0
    let nt_counter = ref 0
    let start_symbol = ref ""
    let clone = ref true
    let decs = ref ""
    (* Hashtbl used as a set *)
    let used_events = H.create 20
    let create_monitor_events = H.create 20
    let event_to_number = H.create 20
    let number_to_event = H.create 20
    (*H.add event_to_number "" "" ;;*)
    let gen_event = H.create 20
    let event_to_expression = H.create 20
    let event_to_action = H.create 20
    let event_to_param_list = H.create 20
    let nt_to_number = H.create 20
    (*H.add event_to_expression "" "" ;;*)

    let mk_string_of_list s l = 
           let base, rest = match l with 
              | h :: t -> h, t
              | [] -> "", [] 
            in
            L.fold_left (fun x y -> x ^ s ^ y ) base rest

    let find h k =
        try
            let value = H.find h k
            in Some(value)
        with Not_found -> None

    let exists h k =
        try 
            H.find h k ; true
        with Not_found -> false

        
    let (=>) x f = f x
    
    let print_event = let i = ref 0 in 
                       (fun s x ->  printf "%s %s %s[%s]:{\n  %s\n %s\n}\n\n" 
                                    s
                                   x
                                   (H.find event_to_param_list x) 
                                   (H.find event_to_expression x)
                                   (H.find event_to_action x)
                                   (if exists used_events x 
                                   then (incr i ; "input = " ^
                                                 (string_of_int !i) ^ ";")
                                   else "input = -1;"  
                                   ) 
                        )
  
   
%}

%token < string > ID PID PASTE_DEC PASTE NUM
%token COLON SEMI ALTERNATE ARROW EOF
       EPSILON EVENT START SYMBOL MINIMAL FORMULA
       LPARAM RPARAM COMMA LPAREN RPAREN  
       AND OR LOR BANG ERROR EQUAL NOTEQUAL

%start main
%type < unit > main

%%
main :
    list(spec_item) EOF
        { 
          let old_dir = Sys.getcwd () 
          in
          Sys.chdir work_dir ;  
          (* build the arrays using maude *)  
          let tmp1 = Filename.temp_file "." "tmp"
          and tmp2 = Filename.temp_file "." "tmp"
          in
          Sys.command ("echo 'red genJavaArrays("^ !start_symbol 
                        ^ ", " ^ !cfg ^ ") .' > " ^ tmp1 ) => ignore; 
          Sys.command ("cat "^ java_cfg ^" "^ tmp1 ^ " | " ^ maude ^ " > " ^ tmp2)
                       =>ignore;  
          let in_chan = open_in tmp2 
          and flag = ref false
          and not_done = ref true
          and rbegin = Str.regexp_string "result Code"
          and rend = Str.regexp_string "Maude> Bye"
          and rerror = Str.regexp ".*ERROR.*"
          and maude_out_str = ref ""
           in
             while !not_done do
                let line = input_line in_chan in
                if (Str.string_match rerror line 0)
                  then (eprintf 
                  ">>>>Formula was null after simplification, check formula\n" ;
                  exit 1 ) ; 
                if (Str.string_match rend line 0) 
                  then (flag := false ; not_done := false);
                if !flag then maude_out_str := !maude_out_str ^ "\n" ^ line; 
                if (Str.string_match rbegin line 0) then flag := true
             done ; 
            let tables, monitor_gen_events =
            match Str.split (Str.regexp_string "//") !maude_out_str with
            | first :: second :: [] -> first, second
            | _ -> (eprintf "Strange maude output, no monitor gen events?\n" ; exit 1 )
          in
          let monitor_gen_events = Str.split (Str.regexp "[, ]") monitor_gen_events
          in L.iter (fun x -> match x with 
                              | "" -> ()
                              | _ ->
                              H.add create_monitor_events 
                             (H.find number_to_event (int_of_string x)) true) monitor_gen_events ;
          printf "//Monitored Events\n" ; 
          L.iter (fun x -> if (exists create_monitor_events x) 
                           then print_event "!" x
                           else print_event "" x) (L.rev !events) ;
           printf   "//State Declaration\n";
           printf   "  IntStack $stack = new IntStack();\n";
           if !clone then 
             printf "  IntStack $end_stack = new IntStack();\n";    
           printf   "  int $done = 0;\n";
           printf   "  int input;\n";
           printf   "%s" ("  " ^ !decs ^ "\n\n");
           printf   "%s\n\n" tables;
           printf   "public int hashcode() {return $stack.peek() ^ $stack.curr_index;}\n" ;
           printf   "public boolean equals(Object o) {\n" ;
           printf   "  if(! (o instanceof @MONITORCLASS)) return false ;\n" ;
           printf   "  @MONITORCLASS m = (@MONITORCLASS) o;\n" ;
           printf   "  if($stack.curr_index != m.$stack.curr_index) return false;\n" ;
           printf   "  for(int i = 0; i < $stack.curr_index ; ++i){\n" ;
           printf   "    if($stack.data[i] != m.$stack.data[i]);\n" ;
           printf   "      return false;\n" ;
           printf   "  }\n" ;
           printf   "  return true;\n" ;
           printf   "}\n" ;
           flush stdout ;
           Sys.command "cat IntStack.java" => ignore ;
           printf   "//Initialization\n";
           printf   "  $stack.push(0);\n\n";
           
           printf   "//Reset\n";
           printf   "  $stack.clear();\n";
           printf   "  $stack.push(0);\n\n";  
          
          (* flush stdout or the next cat commands will end up at the top
           * of the output
           *)
           flush stdout;
          (* Monitoring body in separate files *) 
           if !clone then (Sys.command "cat clone_algo.txt") => ignore
                     else (Sys.command "cat algo.txt") => ignore ;
           Sys.chdir old_dir         
        }
    ;

spec_item :
    EVENT id = ID pl = option(param_list) COLON e = expressions
          act = option(PASTE) option(SEMI) 
        { let paraml = match pl with
            | Some s -> s
            | _ -> ""
          and action = match act with
            | Some s -> s
            | _ -> "" 
          in  H.add event_to_expression id e ; 
              H.add event_to_action id action ;
              H.add event_to_param_list id paraml ;
              H.add event_to_number id ("t(" ^ (string_of_int !t_counter) ^ ")") ;
              H.add number_to_event !t_counter id ;
              t_counter := !t_counter + 1;
              events := id :: (!events);
        }
    |START SYMBOL COLON id = ID option(SEMI)
        { let new_id = ("nt(" ^ (string_of_int !nt_counter) ^ ")")
          in 
            start_symbol := new_id ;
            H.add nt_to_number id new_id ;
            nt_counter := !nt_counter + 1
        }
    |MINIMAL option(SEMI) 
        { clone := false }
    |FORMULA COLON f = formula option(SEMI) 
        { cfg := f }
    |paste = PASTE_DEC
        { decs := !decs ^ paste }
    |ERROR 
        { eprintf "unknown character \n" ; exit(1) }
    ;

formula :
    f = separated_nonempty_list(COMMA, production) 
        { mk_string_of_list " ; " f}
    ;

%inline production :
    nt = ID ARROW lhs = separated_nonempty_list(ALTERNATE, left_hand_side)
        {  let new_id = match find nt_to_number nt with
                        |Some(t) -> t
                        |_ -> (let t = ("nt(" ^ (string_of_int !nt_counter) ^ ")") 
                               in
                                 nt_counter := !nt_counter + 1;
                                 H.add nt_to_number nt t ;
                                 t
                              )
           in 
           new_id ^ " -> " ^ (mk_string_of_list " | " lhs) 
        }
    ;  

%inline left_hand_side :
     sym_list = nonempty_list(ID)
        {   let modified_list =
              L.map (fun x ->  
                         match find event_to_number x with
                         |Some(t) -> (H.add used_events x x; t)
                         |_       -> 
                            (match find nt_to_number x with
                              |Some(t) -> t
                              |_       -> 
                                 (let new_id = ("nt(" ^
                                                  (string_of_int !nt_counter)
                                                  ^ ")")
                                               in 
                                                 nt_counter := !nt_counter + 1;
                                                 H.add nt_to_number x new_id ;
                                                 new_id    
                                               )   
                                 )
                    )
                    sym_list
            in
            mk_string_of_list " " modified_list}
    |EPSILON
        { " . " }
    ;
 
expressions :
    el = list(expression)
      { mk_string_of_list "" el}
    ;

%inline expression :
    LPAREN e = expressions RPAREN
       { "(" ^ e ^ ")" }
    |id = ID
       {id^" "}
    | pid = PID
       {pid^" "}
    | AND
       { " && " }
    | OR
       { " || " }
    | LOR
       { " \\/ " }
    | BANG
       { "!" }
    | COMMA
       { ", " }
    | EQUAL
       { " == " }
    | NOTEQUAL
       { " != " }
    | n = NUM
       { " " ^ n ^ " "}
    ;
    
%inline param_list :
    LPARAM l = separated_list(COMMA, ID) RPARAM {"<" ^ mk_string_of_list ", " l ^">"}
    ;
